unit main;
(*
  srcstr
    main.pas - main unit
    (c)2006-2012 Matthew Hipkin <http://www.matthewhipkin.co.uk>
*)
{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
  ComCtrls, Buttons, ExtCtrls, XMLConf, StrUtils, miscfunc, httpsend,
  xmlparser;

type

  { TfrmMain }

  TfrmMain = class(TForm)
    iconImages: TImageList;
    listFiles: TListView;
    menuEdit: TMenuItem;
    menuHelpTop: TMenuItem;
    menuAbout: TMenuItem;
    menuConn: TMenuItem;
    menuOptions: TMenuItem;
    menuOpenProject: TMenuItem;
    menuNewProject: TMenuItem;
    menuProjects: TMenuItem;
    menuMain: TMainMenu;
    menuFile: TMenuItem;
    mainPanel: TPanel;
    btnConnect: TSpeedButton;
    btnDisconnect: TSpeedButton;
    statusMain: TStatusBar;
    confXML: TXMLConfig;
    timerUpdates: TTimer;
    procedure btnConnectClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure menuAboutClick(Sender: TObject);
    procedure menuConnClick(Sender: TObject);
    procedure menuNewProjectClick(Sender: TObject);
    procedure timerUpdatesTimer(Sender: TObject);
  private
    { private declarations }
    appDir: String;
    procedure loadConfig;
    procedure saveConfig;
    function getProjectDir(id: integer): String;
    procedure saveProjectDirs;
    procedure checkFiles(dir: String; var list: TStrings);
    procedure clearCache;
    procedure addDir(dirname: String; pid: integer);
    procedure setProjectDir(pid: integer; dirname: String);
  public
    { public declarations }
    userAgent: String;
    currProject: integer;
    username: String;
    password: String;
    server: String;
    loggedIn: Boolean;
    projects: TList;
    ignoredFiles: TStrings;
    ignoredDirs: TStrings;
    function httpGet(URL: String): String;
    function httpPost(URL: string; URLData: string): String;
    function httpPostFile(const URL, FieldName, FileName: string; const Data: TStream; const FormFields:TStrings; const ResultData: TStrings): Boolean;
    procedure loadProjects;
    procedure loadFileList;
  end;

var
  frmMain: TfrmMain;

const
  APPVER = '0.2.2';
  CURRVER = 20120822;
  APPNAME = 'srcstr';

implementation

uses projects, about, newproject, connect;

{$R *.lfm}

{ TfrmMain }

function TfrmMain.httpGet(URL: String): String;
var
  HTTP: THTTPSend;
  l: TStrings;
begin
  HTTP := THTTPSend.Create;
  HTTP.UserAgent := userAgent;
  l := TStringList.Create;
  try
    HTTP.HTTPMethod('GET', URL);
    l.LoadFromStream(HTTP.Document);
    Result := l.Text;
  finally
    HTTP.Free;
    l.Free;
  end;
end;

function TfrmMain.httpPost(URL: string; URLData: string): String;
var
  HTTP: THTTPSend;
  l: TStrings;
begin
  HTTP := THTTPSend.Create;
  HTTP.UserAgent := userAgent;
  l := TStringList.Create;
  try
    HTTP.Document.Write(Pointer(URLData)^, Length(URLData));
    HTTP.MimeType := 'application/x-www-form-urlencoded';
    HTTP.HTTPMethod('POST', URL);
    l.LoadFromStream(Http.Document);
    Result := l.Text;
  finally
    HTTP.Free;
    l.Free;
  end;
end;

function TfrmMain.httpPostFile(const URL, FieldName, FileName: string;
  const Data: TStream; const FormFields:TStrings; const ResultData: TStrings): Boolean;
var
  HTTP: THTTPSend;
  Bound, s: string;
  i:integer;
const
  CRLF = #$0D + #$0A;
  FIELD_MASK = CRLF + '--%s' + CRLF +'Content-Disposition: form-data; name="%s"'
    + CRLF + CRLF + '%s';
begin
  Bound := IntToHex(Random(MaxInt), 8) + '_Synapse_boundary';
  HTTP := THTTPSend.Create;
  HTTP.UserAgent := userAgent;
  try
    s := '--' + Bound + CRLF;
    s := s + 'content-disposition: form-data; name="' + FieldName + '";';
    s := s + ' filename="' + FileName +'"' + CRLF;
    s := s + 'Content-Type: Application/octet-string' + CRLF + CRLF;
    HTTP.Document.Write(Pointer(s)^, Length(s));
    HTTP.Document.CopyFrom(Data, 0);
    // Include formfield
    for i:=0 to FormFields.Count-1 do
      begin
        S:= Format(FIELD_MASK,[Bound, FormFields.Names[I], FormFields.Values[FormFields.Names[I]]]);
        HTTP.Document.Write(Pointer(S)^, Length(S));
      end;
    s := CRLF + '--' + Bound + '--' + CRLF;
    HTTP.Document.Write(Pointer(s)^, Length(s));
    HTTP.MimeType := 'multipart/form-data, boundary=' + Bound;
    Result := HTTP.HTTPMethod('POST', URL);
    ResultData.LoadFromStream(HTTP.Document);
  finally
    HTTP.Free;
  end;
end;

procedure TfrmMain.loadConfig;
begin
  username := confXML.GetValue('user/username','');
  password := confXML.GetValue('user/password','');
  server := confXML.GetValue('user/server','');
  if not AnsiEndsText('/',server) then server := server + '/';
end;

procedure TfrmMain.saveConfig;
begin
  confXML.SetValue('user/username',username);
  confXML.SetValue('user/password',password);
  confXML.SetValue('user/server',server);
end;

procedure TfrmMain.addDir(dirname: String; pid: Integer);
var
  s: TSearchRec;
  searchStr: String;
  fs: TFileStream;
  response: TStrings;
  formData: TStrings;
  path: String;
begin
  // If directory doesn't exist or is a system directory then exit;
  if not DirectoryExists(dirname) then exit;
  if (dirname = '.') or (dirname = '..') then exit;
  response := TStringList.Create;
  formData := TStringList.Create;
  searchStr := IncludeTrailingPathDelimiter(dirname) + '*';
  // Search directory for files
  if FindFirst(searchStr, faAnyFile, s) = 0 then
  begin
    repeat
      if (s.Attr and not faDirectory) <> 0 then
      begin
        // Post file
        formData.Clear;
        formData.Add('m=addFile');
        formData.Add('username='+username);
        formData.Add('password='+password);
        formData.Add('proj='+IntToStr(pid));
        formData.Add('md5='+md5checksum(IncludeTrailingPathDelimiter(dirname) + s.Name));
        path := dirname;
        path := AnsiReplaceStr(path,getProjectDir(pid),'');
        {$ifdef Windows}
        path := AnsiReplaceStr(path,'\','/');
        {$endif}
        formData.Add('path='+path);
        fs := TFileStream.Create(IncludeTrailingPathDelimiter(dirname) + s.Name,fmOpenRead);
        httpPostFile(server,'upfile',ExtractFileName(s.name),fs,formData,response);
        fs.Free;
      end
      // Another directory found, recurse into
      else
      begin
        if (s.Name <> '.') and (s.Name <> '..') then addDir(IncludeTrailingPathDelimiter(dirname) + s.Name,pid);
      end;
    until FindNext(s) <> 0;
  end;
  response.Free;
  formData.Free;
end;

function TfrmMain.getProjectDir(id: Integer): String;
var
  xml: TStrings;
  Parser: TXMLParser;
  pid, aserver, localdir: String;
  aProj: Boolean;
begin
  xml := TStringList.Create;
  aProj := false;
  Result := '';
  if FileExists(appdir + 'projects.conf') then
  begin
    xml.LoadFromFile(appdir + 'projects.conf');
    Parser := TXMLParser.Create(xml.Text);
    while Parser.Next do
    begin
      if Parser.TagType = ttBeginTag then
      begin
        if Parser.Name = 'project' then
        begin
          aProj := true;
          pid := '';
          aserver := '';
          localdir := '';
        end;
        if (Parser.Name = 'id') and (aProj = true) then
          pid := Parser.ContentCode;
        if (Parser.Name = 'server') and (aProj = true) then
          aserver := Parser.ContentCode;
        if (Parser.Name = 'localdir') and (aProj = true) then
          localdir := Parser.ContentCode;
      end;
      if (Parser.TagType = ttEndTag) and (Parser.Name = 'project') then
      begin
        aProj := false;
        if (id = StrToInt(pid)) and (aserver = server) then
        begin
          Result := localdir;
          break;
        end;
      end;
    end;
    Parser.Free;
  end;
end;

procedure TfrmMain.saveProjectDirs;
var
  x: integer;
  xml: TStrings;
  p: ^TskProject;
begin
  xml := TStringList.Create;
  xml.Add('<?xml version="1.0" ?>');
  xml.Add('<projects>');
  for x := 0 to projects.Count -1 do
  begin
    p := projects[x];
    if p^.localDir <> '' then
    begin
      xml.Add('  <project>');
      xml.Add('    <id>'+IntToStr(p^.id)+'</id>');
      xml.Add('    <server>'+server+'</server>');
      xml.Add('    <localdir>'+p^.localDir+'</localdir>');
      xml.Add('  </project>');
    end;
  end;
  xml.Add('</projects>');
  xml.SaveToFile(appdir + 'projects.conf');
  xml.Free;
end;

procedure TfrmMain.setProjectDir(pid: integer; dirname: String);
var
  i: integer;
  p: ^TskProject;
begin
  for i := 0 to projects.Count -1 do
  begin
    p := projects[i];
    if p^.id = pid then p^.localDir := dirname;
  end;
  saveProjectDirs;
end;

procedure TfrmMain.loadProjects;
var
  formData: String;
  response: String;
  p: ^TskProject;
  Parser: TXMLParser;
  newOne: Boolean;
begin
  formData := 'm=listProjects&username='+username+'&password='+password;
  response := httpPost(server, formData);
  newOne := false;
  if checkError(response) > 0 then exit;
  projects.Clear;
  Parser := TXMLParser.Create(response);
  while Parser.Next do
  begin
    if Parser.TagType = ttBeginTag then
    begin
      if Parser.Name = 'project' then
      begin
        newOne := true;
        new(p);
      end;
      if (Parser.Name = 'id') and (newOne = true) then
        p^.id := StrToInt(Parser.ContentCode);
      if (Parser.Name = 'title') and (newOne = true) then
        p^.title := Parser.ContentCode;
      if (Parser.Name = 'description') and (newOne = true) then
        p^.description := Parser.ContentCode;
    end;
    if (Parser.Name = 'project') and (Parser.TagType = ttEndTag) then
    begin
      newOne := false;
      p^.localDir := getProjectDir(p^.id);
      projects.Add(p);
    end;
  end;
  Parser.Free;
end;

procedure TfrmMain.loadFileList;
var
  formData: String;
  response: String;
  l: TListItem;
  Parser: TXMLParser;
  add: Boolean;
  fid,fname,fsize,fdate,fpath,fver: String;
begin
  formData := 'm=listFiles&username='+username+'&password='+password+'&proj='+IntToStr(currProject);
  response := httpPost(server, formData);
  //showmessage(response);
  add := false;
  listFiles.Clear;
  Parser := TXMLParser.Create(response);
  while Parser.Next do
  begin
    if Parser.TagType = ttBeginTag then
    begin
      if Parser.Name = 'file' then
      begin
        add := true;
        fid := '';
        fname := '';
        fsize := '';
        fdate := '';
        fpath := '';
        fver := '';
      end;
      if (Parser.Name = 'id') and (add = true) then
        fid := Parser.ContentCode;
      if (Parser.Name = 'filename') and (add = true) then
        fname := Parser.ContentCode;
      if (Parser.Name = 'filesize') and (add = true) then
        fsize := Parser.ContentCode;
      if (Parser.Name = 'filedate') and (add = true) then
        fdate := Parser.ContentCode;
      if (Parser.Name = 'filepath') and (add = true) then
        fpath := Parser.ContentCode;
      if (Parser.Name = 'revision') and (add = true) then
        fver := Parser.ContentCode;
    end;
    if (Parser.TagType = ttEndTag) and (Parser.Name = 'file') then
    begin
      add := false;
      l := listFiles.Items.Add;
      l.Caption := fid;
      l.SubItems.Add(fpath + '/' + fname);
      l.SubItems.Add(fsize);
      l.SubItems.Add(fver);
      l.SubItems.Add(fdate);
    end;
  end;
  Parser.Free;
end;

procedure TfrmMain.checkFiles(dir: String; var list: TStrings);
var
  x: integer;
  add: Boolean;
begin
  list.Clear;
  // Check files to make sure local version is up to date
  for x := 0 to listFiles.Items.Count -1 do
  begin
    // TODO: Scan the local directory for any files that need adding
    add := false;
    // Firstly check for existance
    if not FileExists(dir + PathDelim + listFiles.Items[x].SubItems[0]) then list.Add(listFiles.Items[x].SubItems[0])
    // Secondly compare file sizes
    // TODO: Use a hash instead to decide if a file has been changed?
    else if skFileSize(dir + PathDelim + listFiles.Items[x].SubItems[0]) <> StrToInt(listFiles.Items[x].SubItems[1]) then list.Add(listFiles.Items[x].SubItems[0])
  end;
end;

procedure TfrmMain.clearCache;
begin
  // Delete all files in ~/.sourcekeep/cache
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  // Setup application directory
  appdir := GetUserDir + '.sourcekeep' + PathDelim;
  if not DirectoryExists(appdir) then mkdir(appdir);
  // Set window and application title
  frmMain.Caption := APPNAME + ' ' + APPVER;
  Application.Title := APPNAME + ' ' + APPVER;
  // Set up UserAgent
  userAgent := 'srcstr/' + APPVER + ' (' + getOS + '; ' + IntToStr(CURRVER) + ')';
  // Set up initial variables
  currProject := 0;
  loggedIn := false;
  projects := TList.Create;
  ignoredFiles := TStringList.Create;
  ignoredDirs := TStringList.Create;
  // Add some standard files and directories to ignore
  ignoredDirs.Add('.svn');
  ignoredDirs.Add('lib');
  ignoredDirs.Add('backup');
  ignoredFiles.Add('*.o');
  ignoredFiles.Add('*.exe');
  ignoredFiles.Add('*.dll');
  ignoredFiles.Add('*.so');
  ignoredFiles.Add('*.bak');
  ignoredFiles.Add('Thumbs.db');
  ignoredFiles.Add('*.dcu');
  ignoredFiles.Add('*.ppu');
  // Load config
  confXML.Filename := appdir + 'sourcekeep.conf';
  loadConfig;
  // Annoyingly can't seem to set these at design time
  listFiles.Column[1].Width := 150;
  listFiles.Column[2].Width := 80;
  listFiles.Column[3].Width := 40;
  // Start update checker timer
  timerUpdates.Enabled := true;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  saveConfig;
//  saveProjectDirs;
  clearCache;
  projects.Free;
  ignoredFiles.Free;
  ignoredDirs.Free;
end;

procedure TfrmMain.menuAboutClick(Sender: TObject);
begin
  frmAbout.ShowModal;
end;

procedure TfrmMain.menuConnClick(Sender: TObject);
begin
  if frmConnect.ShowModal = mrOK then
  begin
    username := frmConnect.textUsername.Text;
    password := frmConnect.textPassword.Text;
    server := frmConnect.textServer.Text;
    saveConfig;
  end;
end;

procedure TfrmMain.menuNewProjectClick(Sender: TObject);
var
  formData: String;
  response: String;
  Parser: TXMLParser;
  pid: Integer;
begin
  pid := 0;
  if frmNewProject.ShowModal = mrOK then
  begin
    formData := 'm=createProject&username='+username+'&password='+password;
    formData := formData + '&title=' + frmNewProject.textTitle.Text;
    formData := formData + '&description=' + frmNewProject.textDescription.Text;
    response := httpPost(server,formData);
    if checkError(response) = 0 then
    begin
      Parser := TXMLParser.Create(response);
      while Parser.Next do
      begin
        if Parser.TagType = ttBeginTag then
        begin
          if Parser.Name = 'pid' then pid := StrToInt(Parser.ContentCode);
        end;
      end;
      Parser.Free;
      if pid > 0 then
      begin
        currProject := pid;
        loadProjects;
        setProjectDir(pid,frmNewProject.textDirectory.Directory);
        if frmNewProject.checkAddFiles.Checked = true then
        begin
          addDir(frmNewProject.textDirectory.Directory,pid);
        end;
      end;
    end;
  end;
end;

procedure TfrmMain.timerUpdatesTimer(Sender: TObject);
var
  response: String;
begin
  timerUpdates.Enabled := false;
  response := httpGet('http://www.matthewhipkin.co.uk/sourcekeep.txt');
  try
    if StrToInt(trim(response)) > CURRVER then
    begin
      statusMain.Panels[2].Text := 'An update is available';
    end;
  except
  end;
end;

procedure TfrmMain.btnConnectClick(Sender: TObject);
var
  formData: String;
  response: String;
  x: integer;
  p: ^TskProject;
  workFiles: TStrings;
begin
  // Check we have a username and password setup
  if (username = '') and (password = '') then
  begin
    if frmConnect.ShowModal = mrOK then
    begin
      username := frmConnect.textUsername.Text;
      password := frmConnect.textPassword.Text;
      server := frmConnect.textServer.Text;
      saveConfig;
    end;
    if (username = '') and (password = '') and (server = '') then exit;
  end;
  // Create query string
  formData := 'm=login&username='+username+'&password='+password;
  response := httpPost(server,formData);
  if checkError(response) > 0 then
  begin
    showmessage('Error!');
    exit;
  end;
  // Login was successful, get list of projects
  loadProjects;
  // Projects loaded, populate & show projects window
  frmProjects.listProjects.Clear;
  for x := 0 to projects.Count -1 do
  begin
    p := projects[x];
    frmProjects.listProjects.Items.Add(p^.title);
  end;
  if frmProjects.ShowModal = mrOK then
  begin
    if currProject > 0 then
    begin
      // Check project directory
      p := projects[frmProjects.listProjects.ItemIndex];
      if p^.localDir <> frmProjects.textProjectDir.Text then p^.localDir := frmProjects.textProjectDir.Text;
      // Load file list
      loadFileList;
      // Compare local and remote file lists
      workFiles := TStringList.Create;
      checkFiles(p^.localDir, workFiles);
      saveProjectDirs;
      if workFiles.Count > 0 then
      begin
        // Download files, checking each local vs remote version
        // TODO: Add option allowing user to specify local or remote priority
        // TODO: Method of safely detecting deleted files
      end;
      workFiles.Free;
    end;
  end;
end;

end.
